The Electronic Whole Earth Catalog/ElectronicWholeEarthCatalog.img/QUICK SEARCH/stack.txt

Text File | 1989-02-14 | 22KB | 770 lines

-- stack: in
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 2
-- first background id: 2779
-- card count: 2
-- first card id: 3592
-- list block id: 4769
-- print block id: 3487
-- font table block id: 0
-- style table block id: 0
-- free block count: 4
-- free size: 23808 bytes
-- total size: 65536 bytes
-- stack block size: 25088 bytes
-- created by hypercard version: 0x01208000
-- compacted by hypercard version: 0x01228000
-- modified by hypercard version: 0x01228000
-- opened by hypercard version: 0x01228000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x0000220000002200
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0xCC003300CC003300
-- patterns[4]: 0xCC883322CC883322
-- patterns[5]: 0xEE88BB22EE88BB22
-- patterns[6]: 0xEECCBB33EECCBB33
-- patterns[7]: 0xFFCCFF33FFCCFF33
-- patterns[8]: 0xFFEEFFBBFFEEFFBB
-- patterns[9]: 0xFFFFFFBBFFFFFFBB
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
-- 2/1 jdt
on openStack
  initStackList
  openSearch
end openStack

on closeStack
  closeSearchFiles
end closeStack

on doMenu menuChoice
  if menuChoice = "Help" then
    goHelp
  else
    pass doMenu
  end if
end doMenu

on idle
  global keyNum, keyFindings, searchWord

  -- ugly kludge because if you launch from a locked stack, Hypercard
  -- throws away all changes made during openStack
  if the userModify is false then
    set userModify to true
    if number of this card is "1" then
      put keyFindings into fld "findings"
      put searchWord into cd fld "searchFor"
    end if
  end if
  pass idle
end idle

on goHelp
  if number of this card  = 1 then
    put showHelp("Quick Search 1") into helpChoice
  else if number of this card = 2 then
    put showHelp("Quick Search 2") into helpChoice
  end if

  if helpChoice = 1 then
    go to card id 33789 of stack "Introduction"
  else if helpChoice = 2 then
    go to stack "Help"
  else
    -- if helpChoice = 3 then stay here
  end if
end goHelp

function getPath
-- construct the file path of WE stacks and save in global 'thePath'
put long name of this stack into thePath
delete first word of thePath

repeat while last char of thePath <> ":"
  delete last char of thePath
end repeat

delete first char of thePath     -- delete leading Quote
return thePath
end getPath

on zeroFiles
  global textFileNum, keyFileNum, ptrFileNum, keyNum

  put 0 into textFileNum
  put 0 into keyFileNum
  put 0 into ptrFileNum
end zeroFiles

on initStackList
  global stackList

  -- note: there is no stack 13; MUSIC is #14
  put "COMMUNITY,COMMUNICATIONS,CRAFT,HEALTH" into stackList
  put ",HOUSEHOLD,LEARNING,LIVELIHOOD,MEDIA,NOMADICS" after stackList
  put ",PLACE,WHOLE SYSTEMS,INTRODUCTION,,MUSIC" after stackList
end initStackList

on closeSearchFiles
  global textFileNum, keyFileNum, ptrFileNum

  if textFileNum <> 0 then
    get closeFile(textFileNum)
    put 0 into textFileNum
  end if
  if keyFileNum <> 0 then
    get closeFile(keyFileNum)
    put 0 into keyFileNum
  end if
  if ptrFileNum <> 0 then
    get closeFile(ptrFileNum)
    put 0 into ptrFileNum
  end if
end closeSearchFiles

function getTargetOffset target, size
put (target - size/2) into fileOffset
if fileOffset < 0 then put 0 into fileOffset
return (target - fileOffset)
end getTargetOffset

on fillKeysField delta
  -- fill the index display centered around keyNum with delta entries
  -- above and below it
  global keyNum, keyFileNum, maxKey, keyFindings

  if keyFileNum is 0 then
    beep
    exit fillKeysField
  end if

  put abs(delta) into delta  -- Texas code used neg offset here

  -- topFill and bottomFill are the number of CR's that will need to be
  -- added to the keysfield in order to center the target in case the
  -- target is too close to the start or end of the index file
  if keyNum >= delta then
    put keyNum - delta into firstKey
    put 0 into topFill
  else
    put 0 into firstKey
    put delta - keyNum into topFill
  end if

  if keyNum + delta + 1 <= maxKey then
    put keyNum + delta + 1 into lastKey
    put 0 into bottomFill
  else
    put maxKey into lastKey
    put keyNum + delta + 1 - maxKey into bottomFill
  end if

  put getKeys(lastKey - firstKey, firstKey, keyFileNum) into keyFindings

  if topFill <> 0 then
    repeat with i = 1 to topFill
      put Return before keyFindings
    end repeat
  end if

  if bottomFill <> 0 then
    repeat with i = 1 to bottomFill
      put Return after keyFindings
    end repeat
  end if

  put keyFindings into field "findings" of card "Main"
end fillKeysField

---------------------- Scroll Bar Routines -------------------------
-- Scroll bar routines are in stack script so they can be used
-- by scroll bars on different cards.
--
-- To use these routines:
-- 1) Paint a gray scroll bar onto the card.
-- 2) Paste the "Pager" and "Thumb" buttons into position.
-- 3) Setup a hidden card field, "scrollInfo", and fill it with data
--     Item 1: low coordinate of thumb (its location)
--     Item 2: hi coordinate of thumb
--     Item 3: present setting of thumb (1 - range)
--     Item 4: range (number of positions, "stops", of thumb on scroll)
--     Item 5: H or V (horizontal or vertical)
--     Item 6: page size (number of stops to jump when paged)
--
-- All interaction with the scroll bar will be via the scrollInfo
-- values.  Install scroll bar routines into appropriate mouse
-- message scripts to the "Pager" and "Thumb" buttons, along with the
-- routines that respond to changes in the scroll bar.
--------------------------------------------------------------------

function calcSettingPos minCoord, maxCoord, setting, range
-- returns the coordinate position of the thumb for a given setting
put maxCoord - minCoord into thumbDistance
put (setting - 1) * thumbDistance / (range - 1) into thumbPos
put round(thumbPos) into thumbPos
add minCoord to thumbPos
return thumbPos
end calcSettingPos

on updateThumb
  -- uses values in "scrollInfo" to redraw thumb at appropriate position
  put cd field "scrollInfo" into scrollInfo
  put item 1 of scrollinfo into minCoord
  put item 2 of scrollinfo into maxCoord
  put item 3 of scrollinfo into setting
  put item 4 of scrollinfo into range
  put item 5 of scrollinfo into orientation

  put calcSettingPos(minCoord,maxCoord,setting,range) into thumbPos

  get loc of card button "Thumb"
  if item 5 of scrollInfo contains "H" then
    put thumbPos into item 1 of It
  else
    put thumbPos into item 2 of It
  end if
  set loc of button "Thumb" to It
end updateThumb

function calcNearestSetting position, loCoord, hiCoord, range
-- returns nearest setting stop for a given coordinate position
put (position - loCoord) * (range - 1)/(hiCoord - loCoord) into temp
return round(temp) + 1
end calcNearestSetting

on updateSetting
  -- updates setting value in "scrollInfo" according to current
  -- thumb position (in coords)
  put cd field "scrollInfo" into scrollInfo
  put loc of cd button "Thumb" into thumbLoc
  if item 5 of scrollInfo contains "H" then
    put item 1 of thumbLoc into thumbPos
  else
    put item 2 of thumbLoc into thumbPos
  end if

  put item 1 of scrollInfo into loCoord
  put item 2 of scrollInfo into hiCoord
  put item 4 of scrollInfo into range
  put calcNearestSetting(thumbPos, loCoord, hiCoord, range) into item 3 of cd field "scrollInfo"
end updateSetting

on pageThumb
  -- jump the thumb up or down a stop
  put cd field "scrollInfo" into scrollInfo
  if item 5 of scrollInfo contains "H" then
    put item 1 of the loc of card button "Thumb" into thumbPos
    put the mouseH into mousePos
  else
    put item 2 of the loc of card button "Thumb" into thumbPos
    put the mouseV into mousePos
  end if

  put item 3 of scrollInfo into setting
  put item 4 of scrollInfo into range
  put item 6 of scrollinfo into pageSize

  if mousePos > thumbPos then
    add pageSize to setting
  else
    subtract pageSize from setting
  end if

  if setting > range then put range into setting
  else
    if setting < 1 then put 1 into setting
  end if

  put setting into item 3 of cd field "scrollInfo"
  updateThumb
end pageThumb

on dragThumb
  -- we want the thumb to follow the users mouse movement while dragging
  -- so we must catch it on the mouseDown
  put cd field "scrollInfo" into scrollInfo
  put item 1 of scrollInfo into minThumb
  put item 2 of scrollInfo into maxThumb

  if item 5 of scrollInfo contains "H" then
    dragHorizontal minThumb, maxThumb
  else
    dragVertical minThumb, maxThumb
  end if
end dragThumb

on finishDragThumb
  -- updates "scrollInfo" to setting closest to current thumb position
  -- then redraws thumb to that setting stop
  updateSetting
  updateThumb
end finishDragThumb

on dragHorizontal minCoord, maxCoord
  -- fakes dragging the thumb horizontally
  repeat while the mouse is down
    put item 1 of the loc of button Thumb into thumbH
    put the mouseH - thumbH into thumbDelta
    if thumbDelta <> 0 then
      put loc of button Thumb into newThumbLoc
      add thumbDelta to item 1 of newThumbLoc
      if item 1 of newThumbLoc < minCoord then
        put minCoord into item 1 of newThumbLoc
      else
        if item 1 of newThumbLoc > maxCoord then
          put maxCoord into item 1 of newThumbLoc
        end if
      end if
      set loc of button Thumb to newThumbLoc
    end if
  end repeat
end dragHorizontal

on dragVertical minCoord, maxCoord
  -- fakes dragging the thumb horizontally
  repeat while the mouse is down
    put item 2 of the loc of button "Thumb" into thumbV
    put the mouseV - thumbV into thumbDelta
    if thumbDelta <> 0 then
      put loc of button Thumb into newThumbLoc
      add thumbDelta to item 2 of newThumbLoc
      if item 2 of newThumbLoc < minCoord then
        put minCoord into item 2 of newThumbLoc
      else
        if item 2 of newThumbLoc > maxCoord then
          put maxCoord into item 2 of newThumbLoc
        end if
      end if
      set loc of button Thumb to newThumbLoc
    end if
  end repeat
end dragVertical
------------------ end scroll bar routines -------------------------

on doSearchFor
  -- search based on contents of field "searchFor"
  global maxKey, keyFileNum

  put stripLeadingSpace(cd fld "searchFor") into cd fld "searchFor"
  put card field "searchFor" into tempSearchWord

  if tempSearchWord is empty then
    answer "Type something to search for..."  with "OK"
  else
    set cursor to busy
    put jumpKeyNoBeep (tempSearchWord, maxKey, keyFileNum) into tempKeyNum
    if tempKeyNum is empty then
      -- answer "Sorry, not found.  Check search files..." with "OK"
    else
      if tempKeyNum >= maxKey then
        put (maxKey - 1) into tempKeyNum
      end if
      set cursor to busy
      getKeyEntry tempKeyNum
      send updateIndexScrollBar to card "Main"
    end if
  end if
  select text of cd fld "searchFor"
  set cursor to hand
end doSearchFor

on doSearchForBeep
  global maxKey, keyFileNum

  put stripLeadingSpace(cd fld "searchFor") into cd fld "searchFor"
  put card field "searchFor" into tempSearchWord

  if tempSearchWord is empty then
    answer "Type something to search for..." with "OK"
  else
    set cursor to busy
    put jumpKey (tempSearchWord, maxKey, keyFileNum) into tempKeyNum
    if tempKeyNum is empty then
      answer "Sorry, not found.  Check search files..." with "OK"
    else
      if tempKeyNum >= maxKey then
        put (maxKey - 1) into tempKeyNum
      end if
      set cursor to busy
      getKeyEntry tempKeyNum
      send updateIndexScrollBar to card "Main"
    end if
  end if
  select text of cd fld "searchFor"
  set cursor to hand
end doSearchForBeep

on getKeyEntry tempKeyNum
  -- Gets/sets the key globals 'keyNum', 'keyRecord' and 'searchWord',
  -- and fills the "Findings" field.  Called by doSearchWord and the
  -- mouse scripts for the index scrollbar buttons.
  global keyNum, keyFileNum, keyRecord, searchWord

  put tempKeyNum into keyNum
  fillKeysField -7
  put getKeyRecord( keyNum, keyFileNum ) into keyRecord

  -- in a subject search, searchWord can contain commas,
  -- spaces, and trailing whitespace; thus the following gyrations
  put keyRecord into searchWord
  delete item 1 to 2 of searchWord
  put stripTrailingSpace(searchWord) into searchWord
end getKeyEntry

function stripTrailingSpace thisText
if thisText is not empty then
  repeat while last char of thisText <= space
    delete last char of thisText
  end repeat
end if
return thisText
end stripTrailingSpace

function stripLeadingSpace thisText
if thisText is not empty then
  repeat while first char of  thisText <= space
    delete first char of thisText
  end repeat
end if
return thisText
end stripLeadingSpace

on stripSpaceFromSearchFor
  if card field "searchFor" is not empty then
    put card field "searchFor" into temp
    put stripLeadingSpace(temp) into temp
    put stripTrailingSpace(temp) into temp
    put temp into card field "searchFor"
  end if
end stripSpaceFromSearchFor

function IsSearchString
put card field "searchFor" into searchForStr
put line 8 of cd field "Findings" into findingsStr
end IsSearchString

on goOccurrence theOccurrence
  -- Gets the text for a search occurrence and displays it on card 2.
  -- 'keyRecord' and 'occurrence' must be set.
  global occurrence, searchByState

  put theOccurrence into occurrence
  getCardTextAndOffset
  if searchByState = "Full Text" then
    displayTextOccurrence
  else if searchByState = "Subject" then
    displaySubjectOccurrence
  else if searchByState = "Author" then
    displayAuthorOccurrence
  else if searchByState = "Title" then
    displayTitleOccurrence
  else
    displayTextOccurrence
  end if
end goOccurrence

on getCardTextAndOffset
  global ptrFileNum, textFileNum, keyRecord, occurrence
  global foundCardText, findOffset  -- only used by goOccurrence(s)

  put item 1 of keyRecord + occurrence - 1 into ptrNum
  put getPtrRecord( ptrNum, ptrFileNum ) into textOffset

  put 5000 into MAXGRAB
  put grabText( textOffset, MAXGRAB, textFileNum ) into grabbed
  put getTargetOffset(textOffset, MAXGRAB) into grabbedOffset

  put findPrev("##A", grabbedOffset, grabbed) into cardStart
  put findNext("##A", grabbedOffset, grabbed) into cardEnd
  if (cardStart = -1) then put 0 into cardStart
  if (cardEnd = -1) then put (MAXGRAB-1) into cardEnd
  put char cardStart+1 to cardEnd of grabbed into foundCardText
  put ( grabbedOffset - cardStart - 1) into findOffset

  setFoundInfo
end getCardTextAndOffset

on setFoundInfo
  global foundCardText, foundTitle, foundStack
  global foundCardID, foundCardNum, findOffset, searchWord

  put line 1 of foundCardText into accessLine
  put line 2 of foundCardText into titleLine
  subtract the length of accessLine from findOffset
  subtract the length of titleLine from findOffset

  delete word 1 of titleLine
  put titleLine into foundTitle
  put word 2 of accessLine into weStackID
  put getWEStack(weStackID) into foundStack

  put word 3 of accessLine into foundCardID
  put word 4 of accessLine into foundCardNum
  delete line 1 to 2 of foundCardText
end setFoundInfo

on deleteDblAtText
  global foundCardText

  -- delete starting and ending '@@ + CR'
  put offset("@@", foundCardText) into lenKeyWordArea
  delete char 1 to (lenKeyWordArea + 2) of foundCardText
  delete last line of foundCardText
  delete last line of foundCardText
end deleteDblAtText

on findKeyInText
  global searchWord, findOffset

  lock screen
  find chars searchWord in field "theText"
  repeat until word 2 of the foundChunk >= findoffset
    find chars searchWord in field "theText"
  end repeat
  unlock screen
end findKeyInText

on selectKeyInText keyOffset
  -- not used; alternate method of hiliting search target on card 2
  -- by inverting the text instead of using the HyperCard 'find'
  -- to put a rectangle around it
  global searchWord

  if keyOffset < 0 then
    exit selectKeyInText
  end if

  put the length of searchWord into keyLength
  subtract 1 from keyLength
  if (char 1 of card field "key" <> char keyOffset of field "theText") then subtract 1 from keyOffset
  select char keyOffset to (keyOffset + keyLength) of field "theText"
end selectKeyInText

on displayTextOccurrence
  go to card "Occurrence"
  send "displayOccurrence" to card "Occurrence"
  findKeyInText
end displayTextOccurrence

on displaySubjectOccurrence
  deleteDblAtText
  go to card "Occurrence"
  send "displayOccurrence" to card "Occurrence"
end displaySubjectOccurrence

on displayTitleOccurrence
  global searchWord

  deleteDblAtText
  go to card "Occurrence"
  send "displayOccurrence" to card "Occurrence"
  find chars searchWord in field "foundTitle"
end displayTitleOccurrence

on displayAuthorOccurrence
  global searchWord

  deleteDblAtText
  go to card "Occurrence"
  send "displayOccurrence" to card "Occurrence"
  find chars searchWord in field "theText"
end displayAuthorOccurrence

function getWEStack stackNum
global stackList

return item stackNum of stackList
end getWEStack

function getSearchInName
global searchInState

put searchInState into searchInName
put underscoreSpaces(searchInName) into searchInName

return searchInName
end getSearchInName

on getRandomEntry
  global occurrence, searchWord, maxKey, searchInState

  getkeyEntry ( random(maxKey div 2) + (maxKey div 4) )
  put searchWord into cd field "searchFor"
  send updateIndexScrollBar to card "Main"
  put 1 into occurrence
end getRandomEntry

function underscoreSpaces theName
put length of theName into charCount
repeat with i = 1 to charCount
  if char i of theName is Space then
    put "_" into char i of theName
  end if
end repeat
return theName
end underscoreSpaces
repeat while Space is in theName
  put offset(Space, theName) into spacePos
  put "_" into char spacePos of theName
end repeat

function getSearchFiles baseName
global qsPath, searchFile

-- piece together the search filename
put getPath() & "searchFiles:" & baseName into searchFile

-- put "getSearchFiles" && searchfile into msg

return openIndexFilesjt3(searchFile)
end getSearchFiles

function getSearchByExtension
global searchByState

if searchByState = "Subject" then return ".S"
else if searchByState = "Title" then return ".T"
else if searchByState = "Author" then return ".A"
else if searchByState = "Full Text" then return ".F"
else return empty
end getSearchByExtension

on openSearchFiles
  global textFileNum, maxText, keyFileNum, maxKey
  global ptrFileNum, maxPtr, keyNum

  put getSearchInName() & getSearchByExtension() & ".txt" into baseName
  if baseName is "INTRODUCTION.A.txt" then
    Answer "No search by Author in the Introduction"  with "OK"
    put empty into fld "Findings"
  else if baseName is "INTRODUCTION.S.txt" then
    Answer "No search by Subject in the Introduction"  with "OK"
    put empty into fld "Findings"
  else
    get getSearchFiles(baseName)
    if It <> empty then
      put first item of It into textFileNum
      put second item of It into maxText
      put third item of It into keyFileNum
      put (fourth item of It) / 32 into maxKey
      put fifth item of It into ptrFileNum
      put (sixth item of It) / 4 into maxPtr
      -- put trunc ( maxKey / 2) into keyNum
    else
      Answer "Problem opening index files..." with "OK"
      put empty into fld "Findings" of card 1
    end if
  end if
end openSearchFiles

on reopenSearchFiles
  closeSearchFiles
  openSearchFiles
  if cd fld "searchFor" is empty then
    getRandomEntry
  else
    doSearchFor
  end if
  select text of cd fld "searchFor"
end reopenSearchFiles

on setSearchState
  global searchWord, searchByState, searchInState, keyFindings

  if searchByState is empty then
    put "Full Text" into searchByState
  end if
  send "zeroSearchBy" to card "Main"
  do "set hilite of btn" && Quote & searchByState & Quote && "to true"

  if searchInState is empty then
    put "Whole Catalog" into searchInState
  end if
  do "set the name of cd btn id 15 to" && searchInState

  put searchWord into cd fld "searchFor"
  put keyFindings into fld "findings"
end setSearchState

on resumeQuickSearch
  global searchWord

  setSearchState
  reopenSearchFiles
end resumeQuickSearch

on openSearch
  global returnCard

  -- user may be in card 2 via "Back" or "Recent"
  put the name of this card into entryCard

  hide menubar
  push recent card
  pop card into returnCard  -- for "Return" button

  lock screen
  go to card "Main"
  set cursor to busy
  zeroFiles
  resumeQuickSearch

  go to entryCard
  set cursor to hand
  unlock screen
end openSearch

on emptySearchFields
  go to card 2
  put empty into fld 1
  put empty into fld 2
  put empty into fld 3
  put empty into cd fld 1
  put empty into cd fld 2

  go to card 1
  put empty into fld 1
  put empty into cd fld 1
end emptySearchFields